Dotplot and heatmaps
07/08/2022
1 About this analysis
This notebook produces the dotplot figure(s)
library(dplyr)
library(Seurat)
library(cowplot)
library(patchwork)
library(ggplot2)
library(BiocStyle)
library(harmony)
library(dittoSeq)
library(RColorBrewer)
library(SeuratDisk)
library(SeuratData)2 Preprocess
2.1 Load pre-processed data
E18_PN1_Harmony <- readRDS("ALL_cells_reannotated.rds")2.2 Palettes
## install.packages("Polychrome")
# Color palette
set.seed(123) # for reproducibility
color_palette <- Polychrome::createPalette(25,c("#ff0000", "#00ff00", "#0000ff"))
# c("#fc6060", "#74f774", "#7c7cfc"))
names(color_palette) <- NULL
#Polychrome::swatch(color_palette)DimPlot(object = E18_PN1_Harmony, group.by = "Cell_type_120922", pt.size = 0.5,cols = (color_palette),
label = T, repel = T )
3 Reorder levels
E18_PN1_Harmony@meta.data$Cell_type_120922 <- as.character(Idents(E18_PN1_Harmony))
E18_PN1_Harmony@meta.data$Cell_type_120922[E18_PN1_Harmony@meta.data$Cell_type_120922=="TFP"] = "GFP"
mylevels <- c( "SFP","GFP","AFP", "CLFP", "ACP", "PFP",
"TC", "Chondrogenic",
"Osteogenic", "Myo", "EC", "SC",
"PHP", "HPC",
"Mon_Prog", "Mon_DC", "Sca1_HC",
"B_Lin", "Eo_Bas",
"ICL_TSP2", "Im_Neu", "Neu",
"Oc", "Ery"
)
E18_PN1_Harmony@meta.data$Cell_type_120922 <- factor(E18_PN1_Harmony@meta.data$Cell_type_120922,
levels = mylevels)DimPlot(E18_PN1_Harmony, group.by = "Cell_type_120922", label = T, repel = T )
3.1 Define marker genes
marker_genes <- c(
"Ly6a",# "Cadm3", # SFP
"Gas6", #"Twist2", # GFP
"Ptch2", "Notch3", # AFP
"Entpd2", "Cxcl12",# CLFP
"Tspan15", "Sox5", # ACP
"Nusap1","Mki67", #"Prrx1", # PFP
"Scx", "Tnmd", # Tenogenic
"Sox9", "Col2a1", # Chondrogenic
"Runx2", "Sp7", # Osteogenic
"Cdh15", "Pax7", # Myo
"Pecam1", # EC
"Plp1", # SC
"Ptprc","Ms4a6c","Cenpe", # PHP
"Kit", # "Cd34", # HPC
"Cd14", # Mono Prog
"Cd83", "Ms4a7", # Mono and DC
"Flt3", # Sca1HC
"Cd79a", # B Lin
"Il6","Cd200r3", # Eo and Bas
"Cd3g", "Klrd1", # ILC and TSP2
"Cd177", # Im Neu
"Mmp9", # Neu
"Ctsk", # Oc
"Hbb-bt" # Ery
)p1 <- DotPlot(object = E18_PN1_Harmony,assay = "RNA", group.by = "Cell_type_120922", cols = c("lightcyan" , "magenta4"), dot.scale = 4, features = marker_genes) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + FontSize(x.text = 10) + NoLegend() p1a <- DotPlot(object = E18_PN1_Harmony,assay = "RNA",split.by = "orig.ident", group.by = "Cell_type_120922", cols = c("lightcyan" , "magenta4"), dot.scale = 4, features = marker_genes) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + FontSize(x.text = 10) + NoLegend()
p1a
p1 
p3 <- dittoDotPlot(E18_PN1_Harmony, marker_genes, group.by = "Cell_type_120922", size = 5.5, min.color = "lightcyan", max.color = "purple4", min.percent = 0, legend.color.breaks= c(0, 2, 4))
data_tmp <- p3$data
p3 + geom_tile(aes(y=data_tmp$grouping, x = length(unique(var))+1.5,
size = 0, fill = grouping), show.legend = F) +
scale_fill_manual(values=color_palette)
dittoDotPlot(E18_PN1_Harmony, marker_genes,split.by = "orig.ident", group.by = "Cell_type_120922", size = 5.5, min.color = "lightcyan", max.color = "#660077")#, min.percent = 0, legend.color.breaks= c(0, 2, 4))
pp1 <- p1 + geom_tile(aes(y=data_tmp$grouping, x = -1, #x = length(unique(data_tmp$var)+2),
size = 0, fill = data_tmp$grouping), show.legend = F) +
scale_fill_manual(values=color_palette)
pp1
p0 <- DimPlot(object = E18_PN1_Harmony, group.by = "Cell_type_120922", pt.size = 0.5,cols = (color_palette),
label = T, repel = T ) + ggtitle("") + NoLegend()
p0
p0a <- DimPlot(object = E18_PN1_Harmony, group.by = "Cell_type_120922",
split.by = "orig.ident",
pt.size = 0.1,cols = (color_palette),
label = T, repel = T ) + theme_minimal_grid() + NoLegend()
p0a
p0b <- DimPlot(object = E18_PN1_Harmony, group.by = "Cell_type_120922",
split.by = "orig.ident",
pt.size = 0.1,cols = (color_palette)#,label = T, repel = T )
) + theme_minimal_grid() + NoLegend()
p0b
#p4 <- dittoBarPlot(object = E18_PN1_Harmony, main = "", var = "Cell_type_120922", group.by = "orig.ident", #color.panel = color_palette[24:1] , var.labels.reorder = c(1:24))# + NoLegend()
p4 <- dittoBarPlot(object = E18_PN1_Harmony, main = "", var = "Cell_type_120922", group.by = "orig.ident", color.panel = color_palette[24:1], retain.factor.levels = T, var.labels.reorder = c(24:1))# + NoLegend()
p4
p0 + pp1
p0a / pp1
pp1a <- (p4+NoLegend()) + pp1 + plot_layout(widths = c(1, 4))
p0a + pp1a + plot_layout(heights = c(2,1),ncol = 1 )
#pp1a <- (p4+NoLegend()) + pp1 + plot_layout(widths = c(1, 4))
p0b + pp1a + plot_layout(heights = c(2,1),ncol = 1 )
saveRDS(E18_PN1_Harmony, file = "ALL_cells_reannotated_final.rds")sessionInfo()## R version 4.1.0 (2021-05-18)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.4 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
##
## locale:
## [1] LC_CTYPE=en_GB.UTF-8 LC_NUMERIC=C LC_TIME=en_GB.UTF-8 LC_COLLATE=en_GB.UTF-8 LC_MONETARY=en_GB.UTF-8 LC_MESSAGES=en_GB.UTF-8 LC_PAPER=en_GB.UTF-8 LC_NAME=C LC_ADDRESS=C LC_TELEPHONE=C LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] pbmc3k.SeuratData_3.1.4 SeuratData_0.2.1 SeuratDisk_0.0.0.9019 RColorBrewer_1.1-2 dittoSeq_1.6.0 harmony_0.1.0 Rcpp_1.0.8 ggplot2_3.3.5 patchwork_1.1.1 cowplot_1.1.1 SeuratObject_4.0.2 Seurat_4.0.5 dplyr_1.0.8 BiocStyle_2.22.0
##
## loaded via a namespace (and not attached):
## [1] plyr_1.8.6 igraph_1.2.8 lazyeval_0.2.2 splines_4.1.0 Polychrome_1.5.1 listenv_0.8.0 scattermore_0.7 GenomeInfoDb_1.30.0 digest_0.6.29 htmltools_0.5.2 magick_2.7.3 fansi_1.0.2 magrittr_2.0.2 tensor_1.5 cluster_2.1.2 ROCR_1.0-11 globals_0.14.0 matrixStats_0.61.0 spatstat.sparse_2.0-0 colorspace_2.0-2 rappdirs_0.3.3 ggrepel_0.9.1 xfun_0.29 crayon_1.5.0 RCurl_1.98-1.5 jsonlite_1.8.0 spatstat.data_2.1-0 survival_3.2-13 zoo_1.8-9 glue_1.6.2 polyclip_1.10-0
## [32] gtable_0.3.0 zlibbioc_1.40.0 XVector_0.34.0 leiden_0.3.7 DelayedArray_0.20.0 future.apply_1.8.1 SingleCellExperiment_1.16.0 BiocGenerics_0.40.0 abind_1.4-5 scales_1.1.1 pheatmap_1.0.12 DBI_1.1.1 miniUI_0.1.1.1 viridisLite_0.4.0 xtable_1.8-4 reticulate_1.22 spatstat.core_2.3-1 bit_4.0.4 stats4_4.1.0 htmlwidgets_1.5.4 httr_1.4.2 ellipsis_0.3.2 ica_1.0-2 farver_2.1.0 pkgconfig_2.0.3 sass_0.4.0 uwot_0.1.10 deldir_1.0-6 utf8_1.2.2 labeling_0.4.2 tidyselect_1.1.1
## [63] rlang_1.0.1 reshape2_1.4.4 later_1.3.0 munsell_0.5.0 tools_4.1.0 cli_3.2.0 generics_0.1.1 ggridges_0.5.3 evaluate_0.15 stringr_1.4.0 fastmap_1.1.0 yaml_2.3.5 goftest_1.2-3 bit64_4.0.5 knitr_1.37 fitdistrplus_1.1-6 purrr_0.3.4 RANN_2.6.1 pbapply_1.5-0 future_1.23.0 nlme_3.1-153 mime_0.12 hdf5r_1.3.4 compiler_4.1.0 rstudioapi_0.13 plotly_4.10.0 png_0.1-7 spatstat.utils_2.2-0 tibble_3.1.6 bslib_0.3.1 stringi_1.7.6
## [94] highr_0.9 lattice_0.20-45 Matrix_1.3-4 vctrs_0.3.8 pillar_1.7.0 lifecycle_1.0.1 BiocManager_1.30.16 spatstat.geom_2.3-0 lmtest_0.9-39 jquerylib_0.1.4 RcppAnnoy_0.0.19 data.table_1.14.2 bitops_1.0-7 irlba_2.3.3 httpuv_1.6.3 GenomicRanges_1.46.0 R6_2.5.1 bookdown_0.24 promises_1.2.0.1 KernSmooth_2.23-20 gridExtra_2.3 IRanges_2.28.0 parallelly_1.28.1 codetools_0.2-18 MASS_7.3-54 assertthat_0.2.1 SummarizedExperiment_1.24.0 withr_2.4.3 sctransform_0.3.2 S4Vectors_0.32.1 GenomeInfoDbData_1.2.7
## [125] mgcv_1.8-38 parallel_4.1.0 grid_4.1.0 rpart_4.1-15 tidyr_1.1.4 rmarkdown_2.11 MatrixGenerics_1.6.0 Rtsne_0.15 scatterplot3d_0.3-41 Biobase_2.54.0 shiny_1.7.1